home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / tbbs / prgsourc.zip / EVENTS.ZIP / SORT.PRG < prev    next >
Text File  |  1996-04-24  |  6KB  |  221 lines

  1. SET COLOR TO W+/N
  2. SET DELETED ON
  3.  
  4. buf = 2048
  5. k = " "
  6.  
  7. SELECT a
  8. USE sort INDEX sortord
  9.    
  10. SELECT b
  11. USE week
  12.  
  13. SELECT c
  14. USE month
  15.  
  16. f = 0
  17. DO WHILE f <= 30
  18.    cd = Date()+f
  19.    d  = DtoC(cd)
  20.    dw = Upper(SubStr(cDoW(cd),1,3))
  21.    md = Day(cd)
  22.    dn = Ceiling(md/7)
  23.    df = HomePath() + "DAY\" + SubStr(d,1,2) + SubStr(d,4,2) + SubStr(d,7,2) + ".TXT"
  24. ***********************************************************   
  25.    @ 0,5 SAY "Processing Events for " + d
  26. ********************************  Get events from newev.dbf       
  27.    SELECT a
  28.    @ 1,5 SAY "Adding new events to sort"
  29.    APPEND FROM newev FOR sd = cd               
  30. ********************************  Get events from day file    
  31.    IF File(df)
  32.       @ 2,5 SAY "Adding old events to sort"
  33.       APPEND FROM (df) DELIMITED               
  34.    ENDIF
  35. ********************************  Get events from week.dbf
  36.    SELECT b                                  
  37.    GOTO TOP
  38.    COUNT TO cnt
  39.    IF cnt # 0
  40.       @ 3,5 SAY "Adding weekly events to sort"
  41.       GOTO TOP
  42.       x = 1
  43.       DO WHILE .T.                              
  44.          IF day = dw
  45.             SELECT a
  46.             APPEND BLANK
  47.             REPLACE sd WITH cd, ed WITH cd
  48.             REPLACE sth WITH b->sth, eth WITH b->eth, ca WITH b->ca, cu WITH b->cu, cc WITH b->cc
  49.             REPLACE stm WITH b->stm, etm WITH b->etm, sap WITH b->sap, eap WITH b->eap
  50.             REPLACE cty WITH b->cty, stat WITH b->stat, phn WITH b->phn
  51.             REPLACE ev WITH b->ev, loc WITH b->loc, dsc1 WITH b->dsc1, dsc2 WITH b->dsc2
  52.             REPLACE owner WITH b->owner, poster WITH b->poster
  53.             REPLACE subject WITH b->subject, sb WITH b->sb
  54.             SELECT b
  55.          ENDIF   
  56.          IF x = cnt 
  57.             EXIT
  58.          ENDIF
  59.          SKIP
  60.          x = x + 1
  61.       ENDDO
  62.    ENDIF
  63. ********************************  Get events from month.dbf
  64.    SELECT c
  65.    GOTO TOP
  66.    COUNT TO cnt
  67.    IF cnt # 0
  68.       @ 4,5 SAY "Adding monthly events to sort"
  69.       GOTO TOP
  70.       x = 1
  71.       DO WHILE .T.                
  72.          ok = .F.
  73.          IF day = "MON" .OR. day = "TUE" .OR. day = "WED" .OR. day = "THU" .OR. day = "FRI" .OR. day = "SAT" .OR. day = "SUN" .AND. dayn < 6
  74.             IF day = dw .AND. dn = dayn
  75.                ok = .T.
  76.             ENDIF
  77.          ELSE
  78.             IF md = dayn
  79.                ok = .T.
  80.             ENDIF
  81.          ENDIF
  82.          IF ok
  83.             SELECT a
  84.             APPEND BLANK
  85.             REPLACE sd WITH cd, ed WITH cd
  86.             REPLACE sth WITH c->sth, eth WITH c->eth, ca WITH c->ca, cu WITH c->cu, cc WITH c->cc
  87.             REPLACE stm WITH c->stm, etm WITH c->etm, sap WITH c->sap, eap WITH c->eap
  88.             REPLACE cty WITH c->cty, stat WITH c->stat, phn WITH c->phn
  89.             REPLACE ev WITH c->ev, loc WITH c->loc, dsc1 WITH c->dsc1, dsc2 WITH c->dsc2
  90.             REPLACE owner WITH c->owner, poster WITH c->poster
  91.             REPLACE subject WITH c->subject, sb WITH c->sb
  92.             SELECT c
  93.          ENDIF   
  94.          IF x = cnt 
  95.             EXIT
  96.          ENDIF
  97.          SKIP
  98.          x = x + 1
  99.       ENDDO
  100.    ENDIF
  101.  
  102. ******************************** Create .DAY file
  103.    
  104.    SELECT a             && sort.dbf            sortord.ndx
  105.    GOTO TOP
  106.    COUNT TO i
  107.    @ 5,5 SAY "Creating .DAY file"
  108.    GOTO TOP
  109.    
  110.    IF i = 0
  111.       dg = HomePath() + "DAY\" + SubStr(d,1,2) + SubStr(d,4,2) + SubStr(d,7,2) + ".DAY"
  112.       IF File(dg)
  113.          ERASE dg
  114.       ENDIF
  115.       FCREATE day &dg 13 0 buf
  116.    ELSE
  117.       x = 1
  118.       DO WHILE .T.
  119.          o = 0  
  120.          IF sap = "p"
  121.             o = 720
  122.          ENDIF
  123.          IF sth # 12
  124.             o = o + sth*60
  125.          ENDIF
  126.          o = o + Val(stm)
  127.          REPLACE ord WITH o
  128.          IF x = i
  129.             EXIT
  130.          ENDIF
  131.          x = x + 1
  132.          SKIP
  133.       ENDDO
  134.       
  135.       GOTO TOP
  136.       IF File(df)
  137.          ERASE df
  138.       ENDIF
  139.       COPY TO (df) DELIMITED
  140.       GOTO TOP
  141.       dg = HomePath() + "DAY\" + SubStr(d,1,2) + SubStr(d,4,2) + SubStr(d,7,2) + ".DAY"
  142.       IF File(dg)
  143.          ERASE dg
  144.       ENDIF
  145.       FCREATE day &dg 13 0 buf
  146.       
  147.       x = 1
  148.       DO WHILE .T.
  149.          sdt = DtoC(sd)
  150.          edt = DtoC(ed)
  151.          s = LTrim(Str(sb))
  152.          IF Len(s) < 3
  153.             s = " " + s
  154.          ENDIF
  155.          
  156.          line = s + owner + subject + dsc1 + dsc2 + Chr(13) + Chr(10)
  157.          FLWRITE day z line
  158.          
  159.          st = LTrim(Str(sth))
  160.          IF Len(st) < 2
  161.             st = " " + st
  162.          ENDIF
  163.          stime = st + ":" + stm + " " + sap + ".m."
  164.       
  165.          et =  LTrim(Str(eth))
  166.          IF Len(et) < 2
  167.             et = " " + et
  168.          ENDIF
  169.          etime = et + ":" + etm + " " + eap + ".m."
  170.          IF ca = 0
  171.             ga = " FREE  "
  172.          ELSE
  173.             ga = "$" + Str(ca,6,2)
  174.          ENDIF
  175.          IF cu = 0
  176.             gu = " FREE  "
  177.          ELSE
  178.             gu = "$" + Str(cu,6,2)
  179.          ENDIF
  180.          IF cc = 0
  181.             gc = "FREE"
  182.          ELSE
  183.             gc = "$" + Str(cc,6,2)
  184.          ENDIF
  185.          ph = "(" + SubStr(phn,1,3) + ")" + SubStr(phn,4,3) + "-" + SubStr(phn,7,4)
  186.          line = ev + loc + cty + stat + ph + ga + gu + gc + stime + etime + poster + Chr(13) + Chr(10)
  187.          FLWRITE day z line
  188.          IF x = i
  189.             EXIT
  190.          ENDIF
  191.          x = x + 1
  192.          SKIP
  193.       ENDDO
  194.    ENDIF
  195.    line = "@@@@@@@@@@@@@@@@@@@@@@@@@" + Chr(13) + Chr(10)
  196.    FLWRITE day z line
  197.    FCLOSE
  198.    @ 0,0 CLEAR TO 7,40
  199.    ZAP
  200.    f = f + 1
  201. ENDDO
  202.  
  203. SELECT d
  204.  
  205. USE newev
  206. COUNT TO i
  207. GOTO TOP
  208. x = 1
  209. DO WHILE x <= i 
  210.    IF sd <= cd
  211.       DELETE
  212.    ENDIF
  213.    IF x = i
  214.       EXIT
  215.    ENDIF
  216.    x = x + 1
  217.    SKIP
  218. ENDDO
  219.  
  220. QUIT
  221.